home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / tttsrc51.zip / NESTTTT5.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  39KB  |  1,073 lines
  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.10                              }
  5. {                                                                          }
  6. {                                                                          }
  7. {               Copyright 1986-1993 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}
  13.                      {       Unit:  NestTTT5          }
  14.                      {--------------------------------}
  15.  
  16. {Revision History:    2/13/89    5.00a corrected calculation of Y2 lines
  17.                                  542 and 544. (thanks Mike!)
  18.                                  5.01a  removed refrences to VER50 and
  19.                                         added DEBUG compiler directive
  20.                      01/04/93    5.10   DPMI compatible version
  21. }
  22.  
  23.  
  24. {$S-,R-,V-}       
  25. {$IFNDEF DEBUG}
  26. {$D-}
  27. {$ENDIF}
  28.  
  29. Unit NestTTT5;
  30.  
  31. INTERFACE
  32.  
  33. Uses CRT, FastTTT5, DOS, WinTTT5, KeyTTT5, StrnTTT5;
  34.  
  35. CONST
  36.    Max_Levels = 10;        {maximum number of nested menus - alter if necessary}
  37.    MenuStrLength = 40;     {maximum length of a menu topic - alter if necessary}
  38.    DontClear    = 0;       {signal to return to same position in menu}
  39.    RefreshTopic = 1;       {signal to rewrite highlighted topic}
  40.    RefreshMenu  = 2;       {signal to reload current menu}
  41.    ClearCurrent = 3;       {signal to remove current menu}
  42.    ClearAll     = 4;       {signal to remove all menus}
  43.    Undefined    = 99;      {despatcher has not been assigned}
  44.  
  45. Type
  46.    {$IFNDEF VER40}
  47.    Nest_Key_Proc =   procedure(var Ch:char; Code:Integer);
  48.    Despatcher_Proc = procedure(Var Code: integer; var Finish:byte);
  49.    {$ENDIF}
  50.  
  51.    MenuStr = string[MenuStrLength];
  52.  
  53.    N_Display = record
  54.                      X           : byte;     {top X coord}
  55.                      Y           : byte;     {top Y coord}
  56.                      LeftSide    : boolean;  {does menu start on left or right}
  57.                      AllowEsc    : boolean;  {can user escape from the top level}
  58.                      BoxType     : byte;     {single,double etc}
  59.                      BoxFCol     : byte;     {Border foreground color}
  60.                      BoxBCol     : byte;     {Border background color}
  61.                      CapFCol     : byte;     {Capital letter foreground color}
  62.                      BacCol      : byte;     {menu background color}
  63.                      NorFCol     : byte;     {normal foreground color}
  64.                      LoFCol      : byte;     {inactive topic foreground color}
  65.                      HiFCol      : byte;     {highlighted topic foreground color}
  66.                      HiBCol      : byte;     {highlighted topic background color}
  67.                      LeftChar    : char;     {left-hand topic highlight character}
  68.                      RightChar   : char;     {right-hand topic highlight character}
  69.                      {$IFNDEF VER40}
  70.                      Hook        : Nest_Key_Proc;   { a procedure called after every key is pressed}
  71.                      Despatcher  : Despatcher_proc;     { the main procedure to execute}
  72.                      {$ENDIF}
  73.                end;
  74.  
  75.     TopicPtr    = ^TopicRecord;
  76.  
  77.     MenuPtr     = ^Nest_Menu;
  78.  
  79.     TopicRecord = record
  80.                         Name : MenuStr;
  81.                         Active: boolean;
  82.                         HotKey : char;
  83.                         RetCode : integer;
  84.                         Sub_Menu: MenuPtr;
  85.                         Next_Topic: TopicPtr;
  86.                    end;
  87.  
  88.     Nest_Menu  = record
  89.                         Title: MenuStr;          {title for menu}
  90.                         Topic_Width: byte;       {width of topics in menu}
  91.                         Visible_Lines : word;    {no. topics in box, 0 is DisplayLines - 2}
  92.                         First_Topic : TopicPtr;      {used internally, do not alter}
  93.                         Total_Topics: word;          {used internally, do not alter}
  94.                    end;
  95.  
  96.   VAR
  97.     {$IFDEF VER40}
  98.     Nest_UserHook : pointer;
  99.     Nest_Despatcher: pointer;
  100.     {$ENDIF}
  101.     N_fatal : Boolean;
  102.     N_Error : Integer;
  103.     NTTT    : N_Display;
  104.  
  105.   Procedure Default_Settings;
  106.   {$IFNDEF VER40}
  107.   Procedure Assign_Despatcher(D:Despatcher_Proc);
  108.   {$ENDIF}
  109.  
  110.   Procedure Initialize_Menu(var Menu:Nest_Menu;
  111.                                 Tit: menuStr;
  112.                                 Width: byte;
  113.                                 Display_Lines: word);
  114.  
  115.   Procedure Add_Topic(var Menu:Nest_Menu;
  116.                           Nam : MenuStr;
  117.                           Activ : boolean;
  118.                           HKey : char;
  119.                           Code : integer;
  120.                           Sub: MenuPtr);
  121.  
  122.   Procedure Modify_Topic(var Menu:Nest_Menu;
  123.                              TopicNo : word;
  124.                              Nam : MenuStr;
  125.                              Activ : boolean;
  126.                              HKey  : char;
  127.                              Code : integer;
  128.                              Sub: MenuPtr);
  129.  
  130.   Procedure Modify_Topic_Name(var Menu:Nest_Menu;
  131.                                   TopicNo : word;
  132.                                   Nam : MenuStr);
  133.  
  134.   Procedure Modify_Topic_Active(var Menu:Nest_Menu;
  135.                                   TopicNo : word;
  136.                                   Activ : Boolean);
  137.  
  138.   Procedure Modify_Topic_HotKey(var Menu:Nest_Menu;
  139.                                     TopicNo : word;
  140.                                     HKey : char);
  141.  
  142.   Procedure Modify_Topic_RetCode(var Menu:Nest_Menu;
  143.                                      TopicNo : word;
  144.                                      Code : integer);
  145.  
  146.   Procedure Modify_Topic_SubMenu(var Menu:Nest_Menu;
  147.                                      TopicNo : word;
  148.                                      Sub : MenuPtr);
  149.  
  150.   Procedure Delete_A_Topic(var Menu:Nest_Menu;TopicNo: word);
  151.  
  152.   Procedure Delete_All_Topics(var Menu:Nest_Menu);
  153.  
  154.   Procedure Show_Nest(var Menu:Nest_Menu);
  155.  
  156. IMPLEMENTATION
  157. var
  158.   Despatcher_Assigned : boolean;
  159.  
  160.   Procedure NestTTT_Error(No : byte);
  161.   {Updates N_error and optionally displays error message then halts program}
  162.   var Msg : String;
  163.   begin
  164.       N_error := No;
  165.       If N_fatal = true then
  166.       begin
  167.           Case No of
  168.           1 :  Msg := 'Insufficient memory to add topic';
  169.           2 :  Msg := 'Insufficient memory to save screen';
  170.           3 :  Msg := 'No active picks in menu';
  171.           4 :  Msg := 'Screen was not previously saved cannot restore';
  172.           5 :  Msg := 'Too many levels in menu. Change Max_Levels in NestTTT';
  173.           6 :  Msg := 'Topic does not exist, cannot modify';
  174.           7 :  Msg := 'A user procedure has not been assigned to despatcher';
  175.           else Msg := '?) -- Utterly confused';
  176.           end; {Case}
  177.           Msg := 'Fatal Error (NestTTT -- '+Msg;
  178.           Writeln(Msg);
  179.           Delay(5000);    {display long enough to read if child process}
  180.           Halt;
  181.       end;
  182.   end;
  183.  
  184. {$F+}
  185.   Procedure Empty_Despatcher(Var Code: integer; var Finish:byte);
  186.   {}
  187.   begin
  188.       Finish := Undefined;
  189.   end; {of proc Empty_Despatcher}
  190.  
  191.   Procedure No_Nest_Hook(var Ch : char; Code: Integer);
  192.   {}
  193.   begin
  194.   end; {of proc No_Nest_Hook}
  195. {$F-}
  196.  
  197.    {$IFDEF VER40}
  198.    Procedure CallFromNestUserHook(var Ch:char; code:integer);
  199.           Inline($FF/$1E/Nest_UserHook);
  200.  
  201.    Procedure CallFromNestDespatcher(Var Code: integer; var Finish:byte);
  202.           Inline($FF/$1E/Nest_Despatcher);
  203.    {$ENDIF}
  204.  
  205.   Procedure Default_Settings;
  206.   begin
  207.       with NTTT do
  208.       begin
  209.           X := 0;
  210.           Y := 0;
  211.           Despatcher_Assigned := false;
  212.           LeftSide     := true;
  213.           AllowEsc := true;
  214.           BoxType      := 1;
  215.           If ColorScreen then
  216.           begin
  217.               BoxFCol      := yellow;
  218.               BoxBCol      := blue;
  219.               CapFCol      := White;
  220.               BacCol       := blue;
  221.               NorFCol      := lightgray;
  222.               LoFCol       := black;
  223.               HiFCol       := white;
  224.               HiBCol       := red;
  225.           end
  226.           else
  227.           begin
  228.               BoxFCol      := white;
  229.               BoxBCol      := black;
  230.               CapFCol      := White;
  231.               BacCol       := black;
  232.               NorFCol      := lightgray;
  233.               LoFCol       := darkgray;
  234.               HiFCol       := white;
  235.               HiBCol       := black;
  236.           end;
  237.           LeftChar     := Chr(16);
  238.           RightChar    := Chr(17);
  239.           {$IFNDEF VER40}
  240.           Hook := No_Nest_Hook;
  241.           Despatcher   := Empty_Despatcher;
  242.           {$ELSE}
  243.            Nest_UserHook := nil;
  244.            Nest_Despatcher:= nil;
  245.           {$ENDIF}
  246.       end;  {with}
  247.   end;  {Default_Settings}
  248.  
  249.   {$IFNDEF VER40}
  250.   Procedure Assign_Despatcher(D:Despatcher_Proc);
  251.   begin
  252.       NTTT.Despatcher := D;
  253.       Despatcher_Assigned := true;
  254.   end;
  255.   {$ENDIF}
  256.  
  257.   Procedure Initialize_Menu(var Menu:Nest_Menu;
  258.                                 Tit: menuStr;
  259.                                 Width: byte;
  260.                                 Display_Lines: word);
  261.   {}
  262.   begin
  263.       With Menu do
  264.       begin
  265.           Title         := Tit;
  266.           Topic_Width   := Width;
  267.           Visible_Lines := Display_Lines;
  268.           First_Topic   := nil;
  269.           Total_Topics  := 0;
  270.       end; {with}
  271.   end; {of proc Initialize_Menu}
  272.  
  273.   Procedure Add_Topic(var Menu:Nest_Menu;
  274.                           Nam : MenuStr;
  275.                           Activ : boolean;
  276.                           HKey  : char;
  277.                           Code : integer;
  278.                           Sub: MenuPtr);
  279.   {Adds a new topic to the menu.}
  280.   var
  281.      TempPtr : TopicPtr;
  282.   begin
  283.       If MaxAvail < SizeOf(TempPtr^) then
  284.       begin
  285.           NestTTT_Error(1);   {not enough memory}
  286.           exit;
  287.       end
  288.       else
  289.          N_Error := 0;
  290.       If Menu.First_Topic = nil then
  291.       begin
  292.          getmem(Menu.First_Topic,SizeOf(TempPtr^));
  293.          TempPtr := Menu.First_Topic;
  294.       end
  295.       else
  296.       begin
  297.          TempPtr := Menu.First_Topic;          {start at bottom}
  298.          while TempPtr^.Next_Topic <> nil do               {loop to unallocated block}
  299.             TempPtr := TempPtr^.Next_Topic;
  300.          GetMem(TempPtr^.Next_Topic,SizeOf(TempPtr^));
  301.          TempPtr := TempPtr^.Next_Topic;
  302.       end;
  303.       with TempPtr^ do
  304.       begin
  305.           Name := Nam;
  306.           If (Name = '-') or (Name = '=') then
  307.              Active := false
  308.           else
  309.              Active := Activ;
  310.           HotKey := Hkey;
  311.           RetCode := Code;
  312.           Sub_Menu := Sub;
  313.           Next_Topic := nil;
  314.       end;
  315.       Inc(Menu.Total_Topics);
  316.   end; {of proc Add_Topic}
  317.  
  318.   Function Pointer_to_Topic(Men:Nest_Menu;TopicNo:word): TopicPtr;
  319.   {returns a pointer to the TopicNo'th entry in menu, or nil
  320.    if greater than Total_Topics}    
  321.   var    
  322.      W       : word;    
  323.      TempPtr : TopicPtr;    
  324.   begin    
  325.       with Men do
  326.       begin    
  327.           If TopicNo > Total_Topics then
  328.              TempPtr := nil
  329.           else    
  330.           begin
  331.               TempPtr := First_Topic;    
  332.               For W := 2 to TopicNo do    
  333.                       TempPtr := TempPtr^.Next_Topic    
  334.           end;    
  335.       end;    
  336.       Pointer_to_Topic := TempPtr;    
  337.   end; {of func Pointer_to_Topic}
  338.  
  339.   Procedure Modify_Topic(var Menu:Nest_Menu;
  340.                              TopicNo : word;
  341.                              Nam : MenuStr;
  342.                              Activ : boolean;
  343.                              HKey  : char;
  344.                              Code : integer;
  345.                              Sub: MenuPtr);
  346.   {Changes all the settings for a topic}
  347.   var TempPtr : TopicPtr;
  348.   begin
  349.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  350.       If TempPtr = nil then 
  351.          NestTTT_Error(6);
  352.       With TempPtr^ do
  353.       begin
  354.           Name := Nam;
  355.           If (Name = '-') or (Name = '=') then
  356.              Active := false
  357.           else
  358.              Active := Activ;
  359.           HotKey := Hkey;
  360.           RetCode := Code;
  361.           Sub_Menu := Sub;
  362.       end; {with}
  363.   end; {of proc Modify_Topic}
  364.  
  365.   Procedure Modify_Topic_Name(var Menu:Nest_Menu;
  366.                                   TopicNo : word;
  367.                                   Nam : MenuStr);
  368.   {Change title or name of a topic}
  369.   var TempPtr : TopicPtr;
  370.   begin
  371.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  372.       If TempPtr = nil then 
  373.          NestTTT_Error(6);
  374.       TempPtr^.Name := Nam;
  375.       If (Nam = '-') or (Nam = '=') then
  376.              TempPtr^.Active := false;
  377.   end; {of proc Modify_Topic_Name}
  378.  
  379.   Procedure Modify_Topic_Active(var Menu:Nest_Menu;
  380.                                   TopicNo : word;
  381.                                   Activ : Boolean);
  382.   {Changes active status of a topic}
  383.   var TempPtr : TopicPtr;
  384.   begin
  385.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  386.       If TempPtr = nil then 
  387.          NestTTT_Error(6);
  388.       TempPtr^.Active := Activ;
  389.   end; {of proc Modify_Topic_Active}
  390.  
  391.   Procedure Modify_Topic_HotKey(var Menu:Nest_Menu;
  392.                                     TopicNo : word;
  393.                                     HKey : char);
  394.   {Changes Hotkey character of a topic}
  395.   var TempPtr : TopicPtr;
  396.   begin
  397.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  398.       If TempPtr = nil then
  399.          NestTTT_Error(6);
  400.       TempPtr^.HotKey := HKey;
  401.   end; {of proc Modify_Topic_HotKey}
  402.  
  403.   Procedure Modify_Topic_RetCode(var Menu:Nest_Menu;
  404.                                      TopicNo : word;
  405.                                      Code : integer);
  406.   {Changes Return code for a topic}
  407.   var TempPtr : TopicPtr;
  408.   begin
  409.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  410.       If TempPtr = nil then 
  411.          NestTTT_Error(6);
  412.       TempPtr^.Retcode := Code;
  413.   end; {of proc Modify_Topic_HotKey}
  414.  
  415.   Procedure Modify_Topic_SubMenu(var Menu:Nest_Menu;
  416.                                      TopicNo : word;
  417.                                      Sub : MenuPtr);
  418.   {Changes Return code for a topic}
  419.   var TempPtr : TopicPtr;
  420.   begin
  421.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  422.       If TempPtr = nil then
  423.          NestTTT_Error(6);
  424.       TempPtr^.Sub_Menu := Sub;
  425.   end; {of proc Modify_Topic_HotKey}
  426.  
  427.   Procedure Delete_A_Topic(var Menu:Nest_Menu;TopicNo: word);
  428.   {}
  429.   var TempPtrA,TempPtrB : TopicPtr;
  430.   begin
  431.       If TopicNo = 1 then
  432.       begin
  433.           If Menu.First_Topic = nil then
  434.              NestTTT_Error(6);
  435.           TempPtrA := Menu.First_Topic^.Next_Topic;
  436.           FreeMem(Menu.First_Topic,SizeOf(TempPtrA^));
  437.           Menu.First_Topic := TempPtrA;
  438.       end
  439.       else
  440.       begin
  441.           TempPtrA := Pointer_To_Topic(Menu,pred(TopicNo));
  442.           If TempPtrA = nil then
  443.              NestTTT_Error(6);
  444.           TempPtrB := Pointer_To_Topic(Menu,TopicNo);
  445.           If TempPtrB = nil then
  446.              NestTTT_Error(6);
  447.           TempPtrA^.Next_Topic := TempPtrB^.Next_Topic;
  448.           FreeMem(TempPtrB,SizeOf(TempPtrB^));
  449.       end;
  450.       Dec(Menu.Total_Topics);
  451.   end; {of proc Delete_A_Topic}
  452.  
  453.   Procedure Delete_All_Topics(var Menu:Nest_Menu);
  454.   {}
  455.   var TempPtrA,TempPtrB : TopicPtr;
  456.   begin
  457.       TempPtrA := Menu.First_Topic;
  458.       While (TempPtrA <> nil) do
  459.       begin
  460.           TempPtrB := TempPtrA^.Next_Topic;
  461.           If TempPtrA <> nil then
  462.           begin
  463.               FreeMem(TempPtrA,SizeOf(TempPtrA^));
  464.               TempPtrA := TempPtrB;
  465.           end;
  466.       end;
  467.       Menu.First_Topic := nil;
  468.   end; {of proc Delete_All_Topics}
  469.  
  470.   Procedure Show_Nest(var Menu:Nest_Menu);
  471.   Type
  472.      LevelInfo = record
  473.                       Pick : word;
  474.                       TheMenu : MenuPtr;     {link to menu}
  475.                       X1   : integer;           {coords of saved screens}
  476.                       Y1   : integer;
  477.                       X2   : integer;
  478.                       Y2   : integer;
  479.                       TopPick : byte;
  480.                       HiPick  : byte;
  481.                       Saved_Screen: Pointer; {location of saved screen}
  482.                  end;
  483.   Var
  484.      I : word;
  485.      TempPtr : TopicPtr;
  486.      FinCode : byte;
  487.      Nest : array[1..Max_Levels] of LevelInfo;
  488.      Current_Level : byte;
  489.      LiveMenu : Nest_menu;
  490.      ChL : char;
  491.      Found,
  492.      Finished : boolean;
  493.  
  494.       Function Topic_Pointer(TopicNo:word): TopicPtr;
  495.       begin
  496.           Topic_Pointer := Pointer_to_Topic(LiveMenu,TopicNo);
  497.       end; {of func Topic_Pointer}
  498.  
  499.  
  500.       Procedure Compute_Coords(var LiveMenu:Nest_Menu);
  501.       {determines X1,Y1,X2,Y2 for new menu}
  502.       begin
  503.           With Nest[Current_level] do
  504.           begin
  505.               If LiveMenu.Visible_Lines = 0 then
  506.                  LiveMenu.Visible_Lines := DisplayLines-2;
  507.               If LiveMenu.Total_Topics < LiveMenu.Visible_Lines then
  508.                  LiveMenu.Visible_Lines := LiveMenu.Total_Topics;
  509.               If Current_Level = 1 then
  510.               begin
  511.                   If NTTT.X = 0 then
  512.                   begin
  513.                       If NTTT.LeftSide then
  514.                       begin
  515.                           X1 := 1;
  516.                           X2 := LiveMenu.Topic_Width + 4;
  517.                       end
  518.                       else    {RightSide}
  519.                       begin
  520.                           X2 := 80;
  521.                           X1 := 80 - LiveMenu.Topic_Width - 3;
  522.                       end;
  523.                   end
  524.                   else {X not Zero}
  525.                   begin
  526.                       If NTTT.LeftSide then
  527.                       begin
  528.                           X1 := NTTT.X;
  529.                           X2 := pred(X1)+LiveMenu.Topic_Width + 4;
  530.                           If X2 > 80 then
  531.                           begin
  532.                               X2 := 80;
  533.                               X1 := X2 - 3 - LiveMenu.Topic_Width;
  534.                           end;
  535.                       end
  536.                       else    {RightSide}
  537.                       begin
  538.                           X2 := NTTT.X;
  539.                           X1 := X2 - LiveMenu.Topic_Width - 3;
  540.                           If X1 < 1 then
  541.                           begin
  542.                               X1 := 1;
  543.                               X2 := X1 +LiveMenu.Topic_Width +3;
  544.                           end;
  545.                       end;
  546.                   end;
  547.                   If NTTT.Y = 0 then
  548.                      Y1 := 1
  549.                   else
  550.                      Y1 := NTTT.Y;
  551.                   If LiveMenu.Total_Topics >= LiveMenu.Visible_Lines then
  552. {mod 5.00a}          Y2 := Y1 + succ(LiveMenu.Visible_Lines)
  553.                   else
  554.                      Y2 := Y1 + succ(LiveMenu.Total_Topics);
  555.                   If Y2 > DisplayLines then
  556.                   begin
  557.                      Y2 := DisplayLines;
  558.                      LiveMenu.Visible_Lines := Y2 - succ(Y1);
  559.                   end;
  560.               end
  561.               else   {not the first level menu}
  562.               begin
  563.                   If NTTT.LeftSide then
  564.                   begin
  565.                       X1 := pred(Nest[pred(Current_Level)].X2);
  566.                       X2 := X1 + 3 + LiveMenu.Topic_Width;
  567.                       If X2 > 80 then
  568.                       begin
  569.                           X2 := 80;
  570.                           X1 := X2 - 4 - LiveMenu.Topic_Width;
  571.                       end;
  572.                   end
  573.                   else   {rightside}
  574.                   begin
  575.                       X2 := succ(Nest[pred(Current_Level)].X1);
  576.                       X1 := X2 - LiveMenu.Topic_Width - 3;
  577.                       If X1 < 1 then
  578.                       begin
  579.                           X1 := 1;
  580.                           X2 := X1 +LiveMenu.Topic_Width +3;
  581.                       end;
  582.                   end;
  583.                   Y1 := succ(Nest[Pred(Current_Level)].Y1) +
  584.                         Nest[Pred(Current_Level)].HiPick -
  585.                         Nest[Pred(Current_Level)].TopPick;
  586.                   If LiveMenu.Total_Topics >= LiveMenu.Visible_Lines then
  587.                      Y2 := succ(Y1) + LiveMenu.Visible_Lines
  588.                   else
  589.                      Y2 := succ(Y1) + LiveMenu.Total_Topics;
  590.                   If Y2 > DisplayLines then
  591.                   begin
  592.                      Y2 := DisplayLines;
  593.                      If Y2 - succ(LiveMenu.Visible_Lines) >= 1 then
  594.                         Y1 := Y2 - succ(LiveMenu.Visible_Lines)
  595.                      else
  596.                      begin
  597.                          Y1 := 1;
  598.                          LiveMenu.Visible_Lines := DisplayLines - 2;
  599.                      end;
  600.                   end;
  601.               end;
  602.           end; {With}
  603.       end; {of proc Compute_Coords}
  604.  
  605.       Procedure Save_Screen;
  606.       {saved part of screen overlayed by menu}
  607.       begin
  608.           with Nest[Current_Level] do
  609.           begin
  610.               If MaxAvail < succ(Y2-Y1)*succ(X2-X1)*2 then
  611.                   NestTTT_Error(2)
  612.               else
  613.               begin
  614.                   GetMem(Saved_Screen,succ(Y2-Y1)*succ(X2-X1)*2);
  615.                   PartSave(X1,Y1,X2,Y2,Saved_Screen^);
  616.               end;
  617.           end;
  618.       end; {of proc Save_Screen}
  619.  
  620.       Procedure Restore_Screen;
  621.       {saved part of screen overlayed by menu}
  622.       begin
  623.           with Nest[Current_Level] do
  624.           begin
  625.               If Saved_Screen = nil then
  626.                   NestTTT_Error(4)
  627.               else
  628.               begin
  629.                   PartRestore(X1,Y1,X2,Y2,Saved_Screen^);
  630.                   FreeMem(Saved_Screen,succ(Y2-Y1)*succ(X2-X1)*2);
  631.               end;
  632.           end;
  633.       end; {of proc Restore_Screen}
  634.  
  635.       Procedure Compute_First_Active_Pick;
  636.       {}
  637.       var I : word;
  638.       begin
  639.           With Nest[Current_level] do
  640.           begin
  641.               TopPick := 1;
  642.               HiPick := 1;
  643.               While (Topic_Pointer(HiPick)^.Active = false)
  644.               and   (HiPick < LiveMenu.Total_Topics) do
  645.                     Inc(HiPick);
  646.               If (Topic_Pointer(HiPick)^.Active = false) then {no active picks in menu}
  647.               begin
  648.                   NestTTT_Error(3);
  649.                   exit;
  650.               end;
  651.               If HiPick > LiveMenu.Visible_Lines then
  652.                  TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  653.           end; {with}
  654.       end; {of proc Compute_First_Active_Pick}
  655.  
  656.       Procedure Compute_Topic_Width(var Livemenu:Nest_Menu);
  657.       {}
  658.       var
  659.         I : word;
  660.         W,Biggest : Byte;
  661.       begin
  662.           Biggest := 0;
  663.           For I := 1 To LiveMenu.Total_Topics do
  664.           begin
  665.               W := length(Topic_Pointer(I)^.Name);
  666.               If Biggest < W then
  667.                  Biggest := W;
  668.           end;
  669.           If Biggest < length(LiveMenu.Title) then
  670.              Biggest := length(LiveMenu.Title);
  671.           LiveMenu.Topic_Width := Biggest;
  672.       end; {of proc Compute_Topic_Width}
  673.  
  674.       Procedure Write_Topic(TopicNo:word;Hilight:boolean);
  675.       {}
  676.       var
  677.         A,Y : byte;
  678.         T : TopicPtr;
  679.       begin
  680.          T := Topic_Pointer(TopicNo);
  681.          If T = Nil then
  682.             exit;
  683.          If HiLight then
  684.             A := attr(NTTT.HiFCol,NTTT.HiBCol)
  685.          else
  686.          begin
  687.              If T^.Active then
  688.                 A := attr(NTTT.NorFcol,NTTT.BacCol)
  689.              else
  690.                 A := attr(NTTT.LoFcol,NTTT.BacCol);
  691.          end;
  692.          with Nest[Current_level] do
  693.          begin
  694.              Y := succ(Y1) + TopicNo - TopPick;
  695.              If HiLight then
  696.                 Fastwrite(succ(X1),Y,A,
  697.                           NTTT.LeftChar+
  698.                           PadLeft(T^.Name,LiveMenu.Topic_Width,' ')+
  699.                           NTTT.Rightchar)
  700.              else
  701.                 Case T^.Name[1] of
  702.                 '-': HorizLine(Succ(X1),Pred(X2),Y,NTTT.BoxFCol,NTTT.BacCol,1);
  703.                 '=': HorizLine(Succ(X1),Pred(X2),Y,NTTT.BoxFCol,NTTT.BacCol,1);
  704.                 else
  705.                     begin
  706.                         Fastwrite(succ(X1),Y,A,
  707.                                   ' '+
  708.                                   PadLeft(T^.Name,LiveMenu.Topic_Width,' ')+
  709.                                   ' ');
  710.                         If (T^.Active) and (First_Capital_Pos(T^.Name) > 0) then
  711.                            Fastwrite(succ(X1)+First_Capital_Pos(T^.Name),
  712.                                      Y,
  713.                                      attr(NTTT.CapFCol,NTTT.BacCol),
  714.                                      First_Capital(T^.Name));
  715.                     end;
  716.                 end; {Case}
  717.          end;
  718.       end; {of proc Write_Topic}
  719.  
  720.       Procedure Display_All_Topics;
  721.       {}
  722.       var I : Integer;
  723.       begin
  724.           with Nest[Current_Level] do
  725.           begin
  726.               For I := TopPick to TopPick+pred(LiveMenu.Visible_Lines) do
  727.                   Write_Topic(I,false);
  728.               Write_Topic(HiPick,true);
  729.           end;
  730.       end; {of proc Display_All_Topics}
  731.  
  732.       Procedure Display_LiveMenu;
  733.       {}
  734.       begin
  735.           with Nest[Current_Level] do
  736.           begin
  737.               FBox(X1,Y1,X2,Y2,NTTT.BoxFCol,NTTT.BoxBCol,NTTT.BoxType);
  738.               WriteBetween(X1,X2,Y1,NTTT.BoxFCol,NTTT.BoxBCol,Livemenu.Title);
  739.           end;
  740.           Display_All_Topics;
  741.       end; {of proc Display_LiveMenu}
  742.  
  743.       Function Next_Pick_Down(Wrap:boolean): word;
  744.       {}
  745.       var P : word;
  746.       begin
  747.           with Nest[Current_Level] do
  748.           begin
  749.               P := HiPick;
  750.               If P < LiveMenu.Total_Topics then
  751.               begin
  752.                   inc(P);
  753.                   while (P < LiveMenu.Total_Topics)
  754.                   and   (Topic_Pointer(P)^.Active = false) do
  755.                         Inc(P);
  756.                   If Topic_Pointer(P)^.Active = false then
  757.                   begin
  758.                       If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  759.                       begin
  760.                          P := TopPick;  {scroll to top}
  761.                          while (P < LiveMenu.Total_Topics)
  762.                          and   (Topic_Pointer(P)^.Active = false) do
  763.                                Inc(P);
  764.                       end
  765.                       else
  766.                          P := Hipick;
  767.                   end;
  768.               end
  769.               else     {P is at bottom of menu}
  770.               begin
  771.                   If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  772.                      P := TopPick;  {scroll to top}
  773.                   while (P < LiveMenu.Total_Topics)
  774.                   and   (Topic_Pointer(P)^.Active = false) do
  775.                         Inc(P);
  776.               end;
  777.               Next_Pick_Down := P;
  778.           end; {with}
  779.       end; {of func Next_Pick_Down}
  780.  
  781.       Function Next_Pick_Up(Wrap:boolean): word;
  782.       {}
  783.       var P : word;
  784.       begin
  785.           with Nest[Current_Level] do
  786.           begin
  787.               P := HiPick;
  788.               If P > 1 then
  789.               begin
  790.                   dec(P);
  791.                   while (P > 1)
  792.                   and   (Topic_Pointer(P)^.Active = false) do
  793.                         Dec(P);
  794.                   If Topic_Pointer(P)^.Active = false then
  795.                   begin
  796.                       If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  797.                       begin
  798.                          P := LiveMenu.Total_Topics;  {scroll to top}
  799.                          while (P > 1)
  800.                          and   (Topic_Pointer(P)^.Active = false) do
  801.                                Dec(P);
  802.                       end
  803.                       else
  804.                          P := Hipick;
  805.                   end;
  806.               end
  807.               else     {P is at top of menu}
  808.               begin
  809.                   If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  810.                   begin
  811.                      P := LiveMenu.Total_Topics;  {scroll to top}
  812.                      while (P > 1)
  813.                      and   (Topic_Pointer(P)^.Active = false) do
  814.                            Dec(P);
  815.                   end;
  816.               end;
  817.               Next_Pick_Up := P;
  818.           end; {with}
  819.       end; {of func Next_Pick_Up}
  820.  
  821.       Procedure Load_Menu(var NewMenu:Nest_Menu);
  822.       {}
  823.       begin
  824.           If Current_Level < Max_Levels then
  825.              Inc(Current_Level)
  826.           else
  827.              NestTTT_Error(5);
  828.           Nest[Current_Level].TheMenu := @NewMenu;
  829.           LiveMenu := NewMenu;
  830.           If LiveMenu.Topic_Width <= 0 then
  831.           begin
  832.              Compute_Topic_Width(LiveMenu);
  833.              NewMenu.Topic_Width := LiveMenu.Topic_Width;
  834.           end;
  835.           Compute_Coords(LiveMenu);
  836.           Compute_Coords(NewMenu);
  837.           Compute_First_Active_Pick;
  838.           Save_Screen;
  839.           Display_LiveMenu;
  840.       end; {of proc Load_Menu;}
  841.  
  842.       Procedure Execute_Command;
  843.       {}
  844.       var
  845.          TempPtr : TopicPtr;
  846.          Code : integer;
  847.       begin
  848.           TempPtr := Topic_Pointer(Nest[Current_Level].HiPick);
  849.           If TempPtr^.Sub_Menu <> nil then
  850.              Load_Menu(TempPtr^.Sub_Menu^)
  851.           else
  852.           begin
  853.               Code := TempPtr^.Retcode;
  854.               {$IFNDEF VER40}
  855.               NTTT.Despatcher(Code,Fincode);
  856.               {$ELSE}
  857.               If Nest_Despatcher <> Nil then
  858.                  CallFromNestDespatcher(Code,Fincode)
  859.               else
  860.                  Fincode := Undefined;
  861.               {$ENDIF}
  862.               Case Fincode of
  863.               Undefined    :NestTTT_Error(7);
  864.               DontClear    :;
  865.               RefreshTopic : Write_Topic(Nest[Current_Level].HiPick,True);
  866.               RefreshMenu  : Display_All_Topics;
  867.               ClearCurrent : begin
  868.                                  Restore_Screen;
  869.                                  If Current_Level > 1 then
  870.                                  begin
  871.                                     Dec(Current_Level);
  872.                                     LiveMenu := Nest[Current_Level].TheMenu^;
  873.                                  end
  874.                                  else
  875.                                     Finished := true;
  876.                              end;
  877.               ClearAll     : begin
  878.                                  While Current_Level > 0 do
  879.                                  begin
  880.                                      Restore_Screen;
  881.                                      Dec(Current_Level);
  882.                                      LiveMenu := Nest[Current_Level].TheMenu^;
  883.                                  end;
  884.                                  Finished := true;
  885.                              end;
  886.               end; {Case}
  887.           end;
  888.       end; {of proc Execute_Command}
  889.  
  890.      Procedure Display_More;
  891.      {}
  892.      var A : byte;
  893.      begin
  894.          If LiveMenu.Visible_Lines < Livemenu.Total_Topics then
  895.             with  Nest[Current_Level] do
  896.             begin
  897.                 A := attr(NTTT.CapFCol,NTTT.BoxBCol);
  898.                 If TopPick > 1 then
  899.                    Fastwrite(X2,Succ(Y1),A,chr(24))
  900.                 else
  901.                    VertLine(X2,Succ(Y1),Succ(Y1),NTTT.BoxFcol,NTTT.BoxBCol,Nttt.Boxtype);
  902.                 If TopPick + Pred(LiveMenu.Visible_Lines) < LiveMenu.Total_Topics then
  903.                    Fastwrite(X2,Pred(Y2),A,chr(25))
  904.                 else
  905.                    VertLine(X2,Pred(Y2),Pred(Y2),NTTT.BoxFcol,NTTT.BoxBCol,Nttt.Boxtype);
  906.             end;
  907.      end; {of proc Display_More}
  908.  
  909.   begin
  910.       Current_level := 0;
  911.       {$IFNDEF VER40}
  912.       If not Despatcher_Assigned then
  913.          NestTTT_Error(7);
  914.       {$ELSE}
  915.       If Nest_Despatcher = nil then
  916.          NestTTT_Error(7);
  917.       {$ENDIF}
  918.       Load_Menu(Menu);
  919.       Finished := False;
  920.       Repeat
  921.            Display_More;
  922.            ChL := GetKey;
  923.            {$IFNDEF VER40}
  924.            NTTT.Hook(ChL,Topic_Pointer(Nest[Current_Level].HiPick)^.RetCode);
  925.            {$ELSE}
  926.            If Nest_UserHook <> Nil then
  927.               CallFromNestUserHook(ChL,Topic_Pointer(Nest[Current_Level].HiPick)^.RetCode);
  928.            {$ENDIF}
  929.            If ChL <> #0 then
  930.            Case upcase(ChL) of
  931.            #132,                               {right button}
  932.            #027    : If Current_Level = 1 then
  933.                      begin
  934.                          If NTTT.AllowEsc then
  935.                          begin
  936.                              Restore_Screen;
  937.                              Finished := true;
  938.                          end;
  939.                      end
  940.                      else
  941.                      begin
  942.                          Restore_Screen;
  943.                          Dec(Current_Level);
  944.                          LiveMenu := Nest[Current_Level].TheMenu^;
  945.                      end;
  946.            #133,                                       {Mouse left button}
  947.            #13     : begin                             {Enter}
  948.                          Execute_Command;
  949.                      end;
  950.            ' ',
  951.            #129,                                       {Mouse down}
  952.            #208    : with Nest[Current_Level] do       {Down arrow}
  953.                      begin
  954.                          Write_Topic(HiPick,False);
  955.                          HiPick := Next_Pick_Down(ChL = #208);
  956.                          If HiPick >= TopPick + LiveMenu.Visible_Lines then
  957.                          begin
  958.                              TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  959.                              Display_All_Topics;
  960.                          end;
  961.                          Write_Topic(HiPick,True);
  962.                      end;
  963.            #128,                                       {Mouse up}
  964.            #200    : with Nest[Current_Level] do       {Up arrow}
  965.                      begin
  966.                          Write_Topic(HiPick,False);
  967.                          HiPick := Next_Pick_Up(ChL = #200);
  968.                          If HiPick < TopPick  then
  969.                          begin
  970.                              TopPick := HiPick;
  971.                              Display_All_Topics;
  972.                          end;
  973.                          Write_Topic(HiPick,True);
  974.                      end;
  975.             #199   : If Nest[Current_Level].HiPick <> 1 then      {Home}
  976.                      begin
  977.                          Compute_First_Active_Pick;
  978.                          Display_All_Topics;
  979.                      end;
  980.             #207   : With Nest[Current_Level] do
  981.                      begin
  982.                          Write_Topic(HiPick,False);
  983.                          HiPick := LiveMenu.Total_Topics;
  984.                          While (HiPick > 0)
  985.                          and (Topic_Pointer(HiPick)^.Active =false) do
  986.                               Dec(HiPick);
  987.                          If HiPick >= TopPick + LiveMenu.Visible_Lines then
  988.                          begin
  989.                              TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  990.                              Display_All_Topics;
  991.                          end;
  992.                          Write_Topic(HiPick,True);
  993.                      end;
  994.            'A'..'Z': with Nest[Current_Level] do
  995.                      begin
  996.                          Found := false;
  997.                          I := HiPick;
  998.                          Repeat      
  999.                               TempPtr := Topic_Pointer(I);
  1000.                               If  (First_Capital(TempPtr^.Name) = upcase(ChL))
  1001.                               and (TempPtr^.Active) then      
  1002.                               begin      
  1003.                                   Found := true;
  1004.                                   Write_Topic(HiPick,false);      
  1005.                                   HiPick := I;
  1006.                                   If HiPick >= TopPick + LiveMenu.Visible_Lines then
  1007.                                   begin
  1008.                                       TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  1009.                                       Display_All_Topics;
  1010.                                   end
  1011.                                   else
  1012.                                      If HiPick < TopPick  then
  1013.                                      begin
  1014.                                          TopPick := HiPick;
  1015.                                          Display_All_Topics;
  1016.                                      end;
  1017.                                      Write_Topic(HiPick,true);
  1018.                               end      
  1019.                               else      
  1020.                                   If I = LiveMenu.Total_Topics then
  1021.                                      I := 1
  1022.                                   else
  1023.                                      Inc(I);
  1024.                          Until Found or (I = HiPick);
  1025.                          If Found then
  1026.                             Execute_Command;
  1027.                      end;
  1028.            else   {see if the user pressed a special key}
  1029.                with Nest[Current_Level] do
  1030.                begin
  1031.                Found := false;
  1032.                I := HiPick;
  1033.                Repeat
  1034.                     TempPtr := Topic_Pointer(I);
  1035.                     If  ((TempPtr^.Hotkey) = ChL)
  1036.                     and (TempPtr^.Active) then
  1037.                     begin
  1038.                         Found := true;
  1039.                         Write_Topic(HiPick,false);
  1040.                         HiPick := I;
  1041.                         If HiPick >= TopPick + LiveMenu.Visible_Lines then
  1042.                         begin
  1043.                             TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  1044.                             Display_All_Topics;
  1045.                         end
  1046.                         else
  1047.                            If HiPick < TopPick  then
  1048.                            begin
  1049.                                TopPick := HiPick;
  1050.                                Display_All_Topics;
  1051.                            end;
  1052.                            Write_Topic(HiPick,true);
  1053.                     end
  1054.                     else
  1055.                         If I = LiveMenu.Total_Topics then
  1056.                            I := 1
  1057.                         else
  1058.                            Inc(I);
  1059.                Until Found or (I = HiPick);
  1060.                If Found then
  1061.                   Execute_Command;
  1062.                end;
  1063.       end; {case}
  1064.       Until Finished;
  1065.   end; {of proc Show_Nest}
  1066.  
  1067.  
  1068. begin
  1069.     Default_Settings;
  1070.     N_Fatal := true;
  1071. end.
  1072.  
  1073.